home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / Round_Cala215421642009.psc / new cal / clsSunrise.cls next >
Text File  |  2006-11-01  |  16KB  |  534 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3. MultiUse = -1 'True
  4. Persistable = 0 'NotPersistable
  5. DataBindingBehavior = 0 'vbNone
  6. DataSourceBehavior  = 0 'vbNone
  7. MTSTransactionMode  = 0 'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "clsSunrise"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. ' ------ Class clsSunRiseSet
  15.  
  16. Option Explicit
  17.  
  18. ' -- The following properties are exposed:
  19. 'Sunrise (r) - Sunrise time
  20. 'Sunset (r) - Sunset time
  21. 'SolarNoon (r) - Solar noon
  22. '
  23. 'CityCount (r) - Number of cities
  24. 'CityName (r) - Name of city, by index
  25. 'City (w) - Sets the longitude/latitude/timezone based off a city
  26. '           name or city index
  27. '
  28. 'TimeZone (r/w) - Current Timezone
  29. 'DaySavings (r/w) - Daylight savings time in effect
  30. 'Longitude (r/w) - Longitude to calculate for
  31. 'Latitude (r/w) - Latitude to calculate for
  32. '
  33. 'DateDay (r/w) - Date to calculate for
  34. '
  35. '
  36. ' -- The following method is exposed
  37. 'CalculateSun - Calculate sunrise, sunset and solar noon
  38. '
  39. '
  40. ' Scott Seligman <scott@scottandmichelle.net>
  41. ' Based off of
  42. '   http://www.srrb.noaa.gov/highlights/sunrise/gen.html
  43.  
  44. 'It calculates the sunrise, sunset, and solar noon given longitude
  45. 'and latitude coordinates.
  46.  
  47. Private Type typeMonth
  48.     Name As String
  49.     NumDays As Long
  50. End Type
  51.  
  52. Private Type typeCity
  53.     Name As String
  54.     Longitude As Double
  55.     Latitude As Double
  56.     TimeZone As Long
  57. End Type
  58.  
  59. Private m_cNumberCities As Long
  60. Private m_Cities() As typeCity
  61.  
  62. Private m_monthList(0 To 11) As typeMonth
  63. Private m_monthLeap(0 To 11) As typeMonth
  64.  
  65. Private m_nTimeZone As Long
  66. Private m_bDaySavings As Boolean
  67. Private m_nLongitude As Double
  68. Private m_nLatitude As Double
  69. Private m_dateSel As Date
  70.  
  71. Private m_dateSunrise As Date
  72. Private m_dateSunset As Date
  73. Private m_dateNoon As Date
  74.  
  75. Public Property Get Sunrise() As Date
  76. Sunrise = m_dateSunrise
  77. End Property
  78.  
  79. Public Property Get Sunset() As Date
  80. Sunset = m_dateSunset
  81. End Property
  82.  
  83. Public Property Get SolarNoon() As Date
  84. SolarNoon = m_dateNoon
  85. End Property
  86.  
  87. Public Property Get CityCount() As Long
  88. CityCount = m_cNumberCities + 1
  89. End Property
  90.  
  91. Public Property Get CityName(nCity As Long) As String
  92. If nCity < 0 Or nCity > m_cNumberCities Then
  93.     CityName = "(Error)"
  94. Else
  95.     CityName = m_Cities(nCity).Name
  96. End If
  97. End Property
  98.  
  99. Public Property Let City(City)
  100. Dim nCity As Long
  101. Dim bFound As Boolean
  102.  
  103. If VarType(City) = vbString Then
  104.     For nCity = 0 To m_cNumberCities
  105.         If Trim(LCase(City)) = Trim(LCase(m_Cities(nCity).Name)) Then
  106.             bFound = True
  107.             Exit For
  108.         End If
  109.     Next
  110.     If Not bFound Then
  111.         nCity = -1
  112.     End If
  113. Else
  114.     If IsNumeric(City) Then
  115.         nCity = City
  116.     Else
  117.         nCity = -1
  118.     End If
  119. End If
  120.  
  121. If nCity < 0 Or nCity > m_cNumberCities Then
  122.     m_nTimeZone = 0
  123.     m_bDaySavings = False
  124.     m_nLongitude = 0
  125.     m_nLatitude = 0
  126. Else
  127.     m_nTimeZone = m_Cities(nCity).TimeZone
  128.     m_bDaySavings = False
  129.     m_nLongitude = m_Cities(nCity).Longitude
  130.     m_nLatitude = m_Cities(nCity).Latitude
  131. End If
  132.  
  133. End Property
  134.  
  135. Public Property Let TimeZone(nNew As Long)
  136. m_nTimeZone = nNew
  137. End Property
  138.  
  139. Public Property Get TimeZone() As Long
  140. TimeZone = m_nTimeZone
  141. End Property
  142.  
  143. Public Property Let DaySavings(bNew As Boolean)
  144. m_bDaySavings = bNew
  145. End Property
  146.  
  147. Public Property Get DaySavings() As Boolean
  148. DaySavings = m_bDaySavings
  149. End Property
  150.  
  151. Public Property Let Longitude(nNew As Double)
  152. m_nLongitude = nNew
  153. End Property
  154.  
  155. Public Property Get Longitude() As Double
  156. Longitude = m_nLongitude
  157. End Property
  158.  
  159. Public Property Let Latitude(nNew As Double)
  160. m_nLatitude = nNew
  161. End Property
  162.  
  163. Public Property Get Latitude() As Double
  164. Latitude = m_nLatitude
  165. End Property
  166.  
  167. Public Property Let DateDay(dateNew As Date)
  168. m_dateSel = dateNew
  169. End Property
  170.  
  171. Public Property Get DateDay() As Date
  172. DateDay = m_dateSel
  173. End Property
  174.  
  175.  
  176. Private Function IsLeapYear(nYear As Long) As Boolean
  177.     If (nYear Mod 4 = 0 And nYear Mod 100 <> 0) Or nYear Mod 400 = 0 Then
  178.         IsLeapYear = True
  179.     Else
  180.         IsLeapYear = False
  181.     End If
  182. End Function
  183.  
  184. Private Function RadToDeg(angleRad As Double) As Double
  185.     RadToDeg = 180 * angleRad / 3.1415926535
  186. End Function
  187.  
  188. Private Function DegToRad(angleDeg As Double) As Double
  189.     DegToRad = 3.1415926535 * angleDeg / 180
  190. End Function
  191.  
  192. Private Function CalcJulianDay(nMonth As Long, nDay As Long, bLeapYear _
  193.             As Boolean) As Long
  194.     
  195.     
  196.     Dim i As Long
  197.     Dim nJulianDay As Long
  198.     
  199.     
  200.     If bLeapYear Then
  201.         For i = 0 To nMonth - 1
  202.             nJulianDay = nJulianDay + m_monthLeap(i).NumDays
  203.         Next
  204.     Else
  205.         For i = 0 To nMonth - 1
  206.             nJulianDay = nJulianDay + m_monthList(i).NumDays
  207.         Next
  208.     End If
  209.     
  210.     nJulianDay = nJulianDay + nDay
  211.     
  212.     CalcJulianDay = nJulianDay
  213. End Function
  214.  
  215. Private Function CalcGamma(nJulianDay As Long) As Double
  216.     
  217.     CalcGamma = (2 * 3.1415926535 / 365) * (nJulianDay - 1)
  218.     
  219. End Function
  220.  
  221. Private Function CalcGamma2(nJulianDay As Long, hour As Long)
  222.     
  223.     CalcGamma2 = (2 * 3.1415926535 / 365) * (nJulianDay - 1 + (hour / 24))
  224.     
  225. End Function
  226.  
  227. Private Function CalcEqOfTime(gamma As Double) As Double
  228.     
  229.     CalcEqOfTime = (229.18 * (0.000075 + 0.001568 * Cos(gamma) - _
  230.             0.032077 * Sin(gamma) - 0.014615 * Cos(2 * gamma) - 0.040849 * _
  231.             Sin(2 * gamma)))
  232.     
  233.     
  234. End Function
  235.  
  236. Private Function CalcSolarDec(gamma As Double) As Double
  237.     
  238.     CalcSolarDec = (0.006918 - 0.399912 * Cos(gamma) + 0.070257 * _
  239.             Sin(gamma) - 0.006758 * Cos(2 * gamma) + 0.000907 * Sin(2 * _
  240.             gamma))
  241.     
  242.     
  243. End Function
  244.  
  245. Private Function acos(x As Double) As Double
  246.     On Error Resume Next
  247.     acos = Atn(-x / Sqr(-x * x + 1)) + 2 * Atn(1)
  248. End Function
  249.  
  250. Private Function CalcHourAngle(lat As Double, solarDec As Double, time _
  251.             As Boolean) As Double
  252.     
  253.     Dim latRad As Double
  254.     latRad = DegToRad(lat)
  255.     
  256.     If time Then
  257.         CalcHourAngle = (acos(Cos(DegToRad(90.833)) / (Cos(latRad) * _
  258.                 Cos(solarDec)) - Tan(latRad) * Tan(solarDec)))
  259.         
  260.     Else
  261.         CalcHourAngle = -(acos(Cos(DegToRad(90.833)) / (Cos(latRad) * _
  262.                 Cos(solarDec)) - Tan(latRad) * Tan(solarDec)))
  263.         
  264.     End If
  265.     
  266. End Function
  267.  
  268. Private Function CalcDayLength(hourAngle As Double) As Double
  269.     CalcDayLength = (2 * Abs(RadToDeg(hourAngle))) / 15
  270. End Function
  271.  
  272. Public Function CalculateSun()
  273.     
  274.     Dim nLatitude As Double
  275.     Dim nLongitude As Double
  276.     Dim dateCalc As Date
  277.     Dim bDaySavings As Long
  278.     Dim nZone As Long
  279.     
  280.     nLatitude = m_nLatitude
  281.     nLongitude = m_nLongitude
  282.     dateCalc = m_dateSel
  283.     bDaySavings = IIf(m_bDaySavings, 60, 0)
  284.     nZone = m_nTimeZone
  285.     
  286.     If nLatitude >= -90 And nLatitude < -89.8 Then
  287.         nLatitude = -89.8
  288.     End If
  289.     If nLatitude <= 90 And nLatitude > 89.8 Then
  290.         nLatitude = 89.8
  291.     End If
  292.     
  293.     ' Calculate the time of sunrise
  294.     
  295.     Dim nJulianDay As Long
  296.     nJulianDay = CalcJulianDay(Month(dateCalc), Day(dateCalc), _
  297.             IsLeapYear(Year(dateCalc)))
  298.     
  299.     
  300.     Dim gamma_solnoon As Double
  301.     Dim eqTime As Double
  302.     Dim solarDec As Double
  303.     
  304.     gamma_solnoon = CalcGamma2(nJulianDay, 12 + (nLongitude / 15))
  305.     eqTime = CalcEqOfTime(gamma_solnoon)
  306.     solarDec = CalcSolarDec(gamma_solnoon)
  307.     
  308.     Dim timeGMT As Double
  309.     timeGMT = CalcSunriseGMT(DatePart("y", dateCalc), nLatitude, _
  310.             nLongitude)
  311.     
  312.     
  313.     Dim solNoonGmt As Double
  314.     solNoonGmt = CalcSolNoonGMT(DatePart("y", dateCalc), nLongitude)
  315.     
  316.     Dim timeLST As Double
  317.     timeLST = timeGMT - (60 * nZone) + bDaySavings
  318.     m_dateSunrise = DateAdd("s", timeLST * 60, Int(m_dateSel))
  319.     
  320.     '*****Calculate Solar noon
  321.     Dim solNoonLST As Double
  322.     solNoonLST = solNoonGmt - (60 * nZone) + bDaySavings
  323.     m_dateNoon = DateAdd("s", solNoonLST * 60, Int(m_dateSel))
  324.     
  325.     
  326.     '***** Calculate the time of sunset
  327.     Dim setTimeGMT As Double
  328.     Dim setTimeLST As Double
  329.     
  330.     setTimeGMT = CalcSunsetGMT(DatePart("y", dateCalc), nLatitude, _
  331.             nLongitude)
  332.     
  333.     setTimeLST = setTimeGMT - (60 * nZone) + bDaySavings
  334.     m_dateSunset = DateAdd("s", setTimeLST * 60, Int(m_dateSel))
  335.     
  336. End Function
  337.  
  338. Private Function CalcSunriseGMT(nJulianDay As Long, nLatitude As Double, _
  339.             nLongitude As Double)
  340.     
  341.     
  342.     Dim gamma As Double
  343.     Dim eqTime As Double
  344.     Dim solarDec As Double
  345.     Dim hourAngle As Double
  346.     Dim delta As Double
  347.     Dim timeDiff As Double
  348.     Dim timeGMT As Double
  349.     
  350.     gamma = CalcGamma(nJulianDay)
  351.     eqTime = CalcEqOfTime(gamma)
  352.     solarDec = CalcSolarDec(gamma)
  353.     hourAngle = CalcHourAngle(nLatitude, solarDec, True)
  354.     delta = nLongitude - RadToDeg(hourAngle)
  355.     timeDiff = 4 * delta
  356.     timeGMT = 720 + timeDiff - eqTime
  357.     
  358.     Dim gamma_sunrise As Double
  359.     
  360.     gamma_sunrise = CalcGamma2(nJulianDay, timeGMT / 60)
  361.     eqTime = CalcEqOfTime(gamma_sunrise)
  362.     solarDec = CalcSolarDec(gamma_sunrise)
  363.     hourAngle = CalcHourAngle(nLatitude, solarDec, True)
  364.     delta = nLongitude - RadToDeg(hourAngle)
  365.     timeDiff = 4 * delta
  366.     timeGMT = 720 + timeDiff - eqTime
  367.     
  368.     CalcSunriseGMT = timeGMT
  369.     
  370. End Function
  371.  
  372. Private Function CalcSolNoonGMT(nJulianDay As Long, nLongitude As _
  373.             Double) As Double
  374.     
  375.     
  376.     Dim gamma_solnoon As Double
  377.     Dim eqTime As Double
  378.     Dim solarNoonDec As Double
  379.     Dim solNoonGmt As Double
  380.     
  381.     gamma_solnoon = CalcGamma2(nJulianDay, 12 + (nLongitude / 15))
  382.     eqTime = CalcEqOfTime(gamma_solnoon)
  383.     solarNoonDec = CalcSolarDec(gamma_solnoon)
  384.     solNoonGmt = 720 + (nLongitude * 4) - eqTime
  385.     
  386.     CalcSolNoonGMT = solNoonGmt
  387.     
  388. End Function
  389.  
  390. Private Function CalcSunsetGMT(nJulianDay As Long, nLatitude As Double, _
  391.             nLongitude As Double) As Double
  392.     
  393.     
  394.     Dim gamma As Double
  395.     Dim eqTime As Double
  396.     Dim solarDec As Double
  397.     Dim hourAngle As Double
  398.     Dim delta As Double
  399.     Dim timeDiff As Double
  400.     Dim setTimeGMT As Double
  401.     
  402.     gamma = CalcGamma(nJulianDay + 1)
  403.     eqTime = CalcEqOfTime(gamma)
  404.     solarDec = CalcSolarDec(gamma)
  405.     hourAngle = CalcHourAngle(nLatitude, solarDec, False)
  406.     delta = nLongitude - RadToDeg(hourAngle)
  407.     timeDiff = 4 * delta
  408.     setTimeGMT = 720 + timeDiff - eqTime
  409.     
  410.     Dim gamma_sunset As Double
  411.     
  412.     gamma_sunset = CalcGamma2(nJulianDay, setTimeGMT / 60)
  413.     eqTime = CalcEqOfTime(gamma_sunset)
  414.     
  415.     solarDec = CalcSolarDec(gamma_sunset)
  416.     
  417.     hourAngle = CalcHourAngle(nLatitude, solarDec, False)
  418.     delta = nLongitude - RadToDeg(hourAngle)
  419.     timeDiff = 4 * delta
  420.     setTimeGMT = 720 + timeDiff - eqTime
  421.     
  422.     CalcSunsetGMT = setTimeGMT
  423.     
  424. End Function
  425.  
  426. Private Sub InitMonths()
  427.     
  428.     m_monthList(0).Name = "January": m_monthList(0).NumDays = 31
  429.     m_monthList(1).Name = "February": m_monthList(1).NumDays = 28
  430.     m_monthList(2).Name = "March": m_monthList(2).NumDays = 31
  431.     m_monthList(3).Name = "April": m_monthList(3).NumDays = 30
  432.     m_monthList(4).Name = "May": m_monthList(4).NumDays = 31
  433.     m_monthList(5).Name = "June": m_monthList(5).NumDays = 30
  434.     m_monthList(6).Name = "July": m_monthList(6).NumDays = 31
  435.     m_monthList(7).Name = "August": m_monthList(7).NumDays = 31
  436.     m_monthList(8).Name = "September": m_monthList(8).NumDays = 30
  437.     m_monthList(9).Name = "October": m_monthList(9).NumDays = 31
  438.     m_monthList(10).Name = "November": m_monthList(10).NumDays = 30
  439.     m_monthList(11).Name = "DEcember": m_monthList(11).NumDays = 31
  440.     
  441.     m_monthLeap(0).Name = "January": m_monthLeap(0).NumDays = 31
  442.     m_monthLeap(1).Name = "February": m_monthLeap(1).NumDays = 28
  443.     m_monthLeap(2).Name = "March": m_monthLeap(2).NumDays = 31
  444.     m_monthLeap(3).Name = "April": m_monthLeap(3).NumDays = 30
  445.     m_monthLeap(4).Name = "May": m_monthLeap(4).NumDays = 31
  446.     m_monthLeap(5).Name = "June": m_monthLeap(5).NumDays = 30
  447.     m_monthLeap(6).Name = "July": m_monthLeap(6).NumDays = 31
  448.     m_monthLeap(7).Name = "August": m_monthLeap(7).NumDays = 31
  449.     m_monthLeap(8).Name = "September": m_monthLeap(8).NumDays = 30
  450.     m_monthLeap(9).Name = "October": m_monthLeap(9).NumDays = 31
  451.     m_monthLeap(10).Name = "November": m_monthLeap(10).NumDays = 30
  452.     m_monthLeap(11).Name = "DEcember": m_monthLeap(11).NumDays = 31
  453.     
  454. End Sub
  455.  
  456. Private Sub AddCity(sCity As String, nLatitude As Double, nLongitude As _
  457.             Double, nZone As Long)
  458.     
  459.     
  460.     m_cNumberCities = m_cNumberCities + 1
  461.     If m_cNumberCities > UBound(m_Cities) Then
  462.         ReDim Preserve m_Cities(UBound(m_Cities) + 10)
  463.     End If
  464.     
  465.     m_Cities(m_cNumberCities).Name = sCity
  466.     m_Cities(m_cNumberCities).Latitude = nLatitude
  467.     m_Cities(m_cNumberCities).Longitude = nLongitude
  468.     m_Cities(m_cNumberCities).TimeZone = nZone
  469.     
  470. End Sub
  471.  
  472. Private Sub InitCities()
  473.     
  474.     m_cNumberCities = -1
  475.     ReDim m_Cities(0)
  476.     
  477.     AddCity "Albuquerque, NM", 35.05, 106.39, 7
  478.     AddCity "Anchorage, AK", 61.13, 149.54, 9
  479.     AddCity "Atlanta, GA", 33.44, 84.23, 5
  480.     AddCity "Boston, MA", 42.21, 71.03, 5
  481.     AddCity "Boulder, CO", 40.125, 105.237, 7
  482.     AddCity "Chicago, IL", 41.51, 87.39, 6
  483.     AddCity "Dallas, TX", 32.46, 96.47, 6
  484.     AddCity "Denver, CO", 39.44, 104.59, 7
  485.     AddCity "Detroit, MI", 42.2, 83.03, 5
  486.     AddCity "Honolulu, HA", 21.18, 157.51, 10
  487.     AddCity "Indianapolis, IN", 39.46, 86.09, 5
  488.     AddCity "Kansas City, MO", 39.05, 94.34, 6
  489.     AddCity "Los Angeles, CA", 34.03, 118.14, 8
  490.     AddCity "Miami, FL", 25.46, 80.11, 5
  491.     AddCity "Minneapolis, nMonth", 44.58, 93.15, 6
  492.     AddCity "New Orleans, LA", 29.57, 90.04, 6
  493.     AddCity "New York City, NY", 40.43, 74.01, 5
  494.     AddCity "Oklahoma City, OK", 35.28, 97.3, 6
  495.     AddCity "Philadelphia, PA", 39.57, 75.09, 5
  496.     AddCity "Phoenix, AZ", 33.26, 112.04, 7
  497.     AddCity "Saint Louis, MO", 38.37, 90.11, 6
  498.     AddCity "San Fransisco, CA", 37.46, 122.25, 8
  499.     AddCity "Seattle, WA", 47.36, 122.19, 8
  500.     AddCity "Washington DC", 38.53, 77.02, 5
  501.     AddCity "Beijing, China", 39.55, -116.25, -8
  502.     AddCity "Berlin, Germany", 52.33, -13.3, -1
  503.     AddCity "Buenos Aires, Argentina", -34.36, 58.27, 3
  504.     AddCity "Cairo, Egypt", -30.06, -31.22, -2
  505.     AddCity "Cape Town, South Africa", -33.55, -18.22, -2
  506.     AddCity "Caracas, Venezula", 10.3, 66.56, 4
  507.     AddCity "Helsinki, Finland", 60.1, -24.58, -2
  508.     AddCity "Hong Kong, China", 22.15, -114.1, -8
  509.     AddCity "London, England", 51.3, 0.1, 0
  510.     AddCity "Mexico City, Mexico", 19.24, 99.09, 6
  511.     AddCity "Moscow, Russia", 55.45, -37.35, -3
  512.     AddCity "New Delhi, India", 28.36, -77.12, -5.5
  513.     AddCity "Ottawa, Canada", 45.25, 75.42, 5
  514.     AddCity "Paris, France", 48.52, -2.2, -1
  515.     AddCity "Rio de Janeiro, Brazil", -22.54, 43.14, 3
  516.     AddCity "Riyadh, Saudi Arabia", 24.38, -46.43, -3
  517.     AddCity "Rome, Italy", 41.54, -12.29, -1
  518.     AddCity "Sydney, Australia", -33.52, -151.13, -10
  519.     AddCity "Tokyo, Japan", 35.42, -139.46, -9
  520.     AddCity "Zurich, Switzerland", 47.23, -8.32, -1
  521.     
  522. End Sub
  523.  
  524. Private Sub Class_Initialize()
  525.     
  526.     InitMonths
  527.     InitCities
  528.     m_dateSel = Now
  529.     
  530. End Sub
  531.  
  532. ' ------ End of class clsSunRiseSet
  533.  
  534.